home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.07 Nov⁄Dec 92 / Jörg's Code
Encoding:
Text File  |  1992-10-28  |  1.7 KB  |  95 lines  |  [TEXT/MPS ]
  1. Listing 1: Setting FPU precision in Absoft Fortran
  2.  
  3.  
  4. C    set rounding precision for ABsoft Fortran
  5.     INTEGER*4 i,getfpcontrol
  6.  
  7.     INTEGER*4 RPCLEAR
  8.     PARAMETER(RPCLEAR=z’FFFFFF3F’)
  9.  
  10.     INTEGER*4 RPSINGLE
  11.     PARAMETER (RPSINGLE=z’00000040’)
  12.  
  13.     i = getfpcontrol()            ! get current control word
  14.     i = (i .and. RPCLEAR)        ! clear current rounding 
  15.                                                precision
  16.     i = (i .or. RPSINGLE)        ! or in new prec.
  17.     call setfpcontrol(i)            ! set new control word
  18.  
  19.  
  20.  
  21.  
  22. Listing 2: Example subroutines from the Linpack and Whetstone benchmarks
  23.  
  24.  
  25. (Whetstone, main program)
  26.     …
  27.     …
  28. C    MODULE 8: PROCEDURE CALLS
  29.     X=1.0
  30.     Y=1.0
  31.     Z=1.0
  32.     DO 80 I=1,N8
  33.         CALL P3(X,Y,Z)
  34.     80    CONTINUE
  35.     …    
  36.     …
  37.  
  38.     SUBROUTINE P3(X,Y,Z)
  39.     COMMON /B/ T,T2
  40.     X=T*(X+Y)
  41.     Y=T*(X+Y)
  42.     Z=(X+Y)/T2
  43.     RETURN
  44.     END
  45.  
  46. (saxpy subroutine from the Linpack benchmark)
  47.  
  48.     subroutine saxpy(n,da,dx,incx,dy,incy)
  49. c
  50. c    constant times a vector plus a vector.
  51. c    uses unrolled loops for increments equal to one.
  52. c    jack dongarra, linpack, 3/11/78.
  53. c
  54.     real dx(1),dy(1),da
  55.     integer i,incx,incy,ix,iy,m,mp1,n
  56. c
  57.     if(n.le.0)return
  58.     if (da .eq. 0.0e0) return
  59.     if(incx.eq.1.and.incy.eq.1)go to 20
  60. c
  61. c    code for unequal increments or equal increments
  62. c    not equal to 1
  63. c
  64.     ix = 1
  65.     iy = 1
  66.     if(incx.lt.0)ix = (-n+1)*incx + 1
  67.     if(incy.lt.0)iy = (-n+1)*incy + 1
  68.     do 10 i = 1,n
  69.           dy(iy) = dy(iy) + da*dx(ix)
  70.           ix = ix + incx
  71.           iy = iy + incy
  72.     10 continue
  73.     return
  74. c
  75. c      code for both increments equal to 1
  76. c
  77. c
  78. c      clean-up loop
  79. c
  80.     20 m = mod(n,4)
  81.     if( m .eq. 0 ) go to 40
  82.     do 30 i = 1,m
  83.         dy(i) = dy(i) + da*dx(i)
  84.     30 continue
  85.     if( n .lt. 4 ) return
  86.     40 mp1 = m + 1
  87.     do 50 i = mp1,n,4
  88.          dy(i) = dy(i) + da*dx(i)
  89.          dy(i + 1) = dy(i + 1) + da*dx(i + 1)
  90.          dy(i + 2) = dy(i + 2) + da*dx(i + 2)
  91.          dy(i + 3) = dy(i + 3) + da*dx(i + 3)
  92.     50 continue
  93.     return
  94.     end
  95.